home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BBS Toolkit
/
BBS Toolkit.iso
/
rbbs_pc
/
173c_utl.zip
/
MAKEFIDX.BAS
< prev
next >
Wrap
BASIC Source File
|
1990-11-20
|
13KB
|
386 lines
DECLARE SUB TRIM (TRIM.PARM$)
DECLARE SUB BRKFNAME (FILENAME$, DRVPATH$, PREFIX$, EXTENSION$, FOR.JOINING%)
DECLARE SUB TRIMTRAIL (TRIM.PARM$, TRIM.THIS$)
DECLARE SUB FINDLAST (LOOK.IN$, LOOK.FOR$, WHERE.FOUND%, NUM.FINDS%)
DEFINT A-Z
DIM FileSpec$(999)
DIM FileDir$(255)
DIM LocationIndex$(999)
TRUE = -1
FALSE = 0
WriteMode$ = "REPLACE"
NameFile$ = "FIDX.DEF"
LocationFile$ = "LIDX.DEF"
DirString$ = "DIRECTORY OF" ' 0216
SHARING = FALSE
NumLocations = 0
NumFileSpecs = 0
NumFileDirs = 0
StartCol = 1 ' 0224
ConfigFile$ = "MAKEFIDX.CFG"
PassedArguments$ = COMMAND$
PassedArguments$ = UCASE$(PassedArguments$)
X = INSTR(PassedArguments$,"/B")
RunBatch = (X > 0)
IF RunBatch THEN
PassedArguments$ = LEFT$(PassedArguments$, X-1) + RIGHT$(PassedArguments$,Len(PassedArguments$)-X-1)
END IF
IF PassedArguments$ <> "" THEN
ConfigFile$ = PassedArguments$
END IF
ON ERROR GOTO 40000
IF SHARING THEN
OPEN ConfigFile$ FOR INPUT SHARED AS #1
ELSE
OPEN ConfigFile$ FOR INPUT AS #1
END IF
ON ERROR GOTO 0
WHILE NOT EOF(1)
LINE INPUT #1, A$
X$ = LEFT$(A$, 1)
IF X$ <> "" AND X$ <> "*" THEN
A$ = UCASE$(A$)
IF LEFT$(A$,11) = "/WRITEMODE=" THEN
WriteMode$ = MID$(A$,12)
CALL TRIM (WriteMode$)
END IF
IF LEFT$(A$, 10) = "/NAMEFILE=" THEN
NameFile$ = MID$(A$, 11)
CALL TRIM(NameFile$)
END IF
IF LEFT$(A$, 14) = "/LOCATIONFILE=" THEN
LocationFile$ = MID$(A$, 15)
CALL TRIM(LocationFile$)
END IF
IF LEFT$(A$, 10) = "/FILESPEC=" THEN
X$ = MID$(A$, 11)
CALL TRIM(X$)
NumFileSpecs = NumFileSpecs + 1
FileSpec$(NumFileSpecs) = X$
END IF
IF LEFT$(A$, 9) = "/FILEDIR=" THEN
X$ = MID$(A$, 10)
CALL TRIM(X$)
NumFileDirs = NumFileDirs + 1
FileDir$(NumFileDirs) = X$
END IF
IF LEFT$(A$,11) = "/DIRSTRING=" THEN ' 0216
X$ = MID$(A$,12) ' 0216
CALL TRIM (X$) ' 0216
DirString$ = X$ ' 0216
DirString$ = UCASE$(DirString$) ' 0220
END IF ' 0216
END IF
WEND
CLOSE 1
Replacing = (LEFT$(WriteMode$, 1) = "R")
PRINT "MAKEFIDX version 1.2 Nov 20, 1990 copyright (c) 1990 by Ken Goosens"
PRINT "an RBBS utility to make files for fast directory searches"
PRINT
PRINT "On this run"
IF Replacing THEN
PRINT "Overwriting data files"
ELSE
PRINT "Adding to data files"
END IF
PRINT "Configuration file used ....... ";ConfigFile$
PRINT "Name of list of files ......... "; NameFile$
PRINT "Name of list of locations ..... "; LocationFile$
PRINT "# of DOS directories to process"; NumFileSpecs
PRINT "# of file lists to process ...."; NumFileDirs
PRINT
IF NOT RunBatch THEN
INPUT "A to abort, anything else runs"; ANS$
ANS$ = UCASE$(ANS$)
IF ANS$ = "A" THEN END
END IF
'NumFileSpecs = 2
'FileSpec$(1) = "C:\TEMP\"
'FileSpec$(2) = "C:\UTILS\"
IF Replacing THEN
ON ERROR GOTO 40100
KILL NameFile$
KILL LocationFile$
ON ERROR GOTO 0
ELSE
IF SHARING THEN
OPEN LocationFile$ FOR INPUT SHARED AS #1
ELSE
OPEN LocationFile$ FOR INPUT AS #1
END IF
PRINT "Loading existing locations..."
WHILE NOT EOF(1)
LINE INPUT #1, A$
CALL TRIM(A$)
NumLocations = NumLocations + 1
LocationIndex$(NumLocations) = A$
WEND
CLOSE 1
PRINT STR$(NumLocations); " locations loaded"
END IF
IF SHARING THEN
OPEN NameFile$ FOR RANDOM SHARED AS #2 LEN = 18
OPEN LocationFile$ FOR RANDOM SHARED AS #3 LEN = 66
ELSE
OPEN NameFile$ FOR RANDOM AS #2 LEN = 18
OPEN LocationFile$ FOR RANDOM AS #3 LEN = 66
END IF
FIELD 2, 18 AS NameRec$
FIELD 3, 66 AS LocationRec$
MID$(NameRec$, 17, 2) = CHR$(13) + CHR$(10)
MID$(LocationRec$, 64, 3) = "." + CHR$(13) + CHR$(10)
NumRecsNameFile = LOF(2) / 18
NumRecsLocationFile = LOF(3) / 66
InFile$ = "IDX.$$$"
FOR ix = 1 TO NumFileSpecs
PRINT "Processing filespec "; FileSpec$(ix) ; ' 112090
' SHELL "DIR " + FileSpec$(ix) + " > IDX.$$$"
' GOSUB ProcessFile
GOSUB ProcessDir ' 112090
NEXT
FOR ix = 1 TO NumFileDirs
InFile$ = FileDir$(ix)
PRINT "Processing file list "; FileDir$(ix) ; ' 112090
GOSUB ProcessFile
NEXT
END
ProcessDir: ' 112090
CALL BRKFNAME (FileSpec$(ix),CurrentDrivePath$,Prefix$,Extension$,TRUE)
CALL FindFirstF(FileSpec$(ix)+CHR$(0),0,RtnCode)
IF RtnCode <> 0 THEN
PRINT
PRINT " No files found"
RETURN
END IF
GOSUB SetLocIndex
RecCt = 0
PrtCol = POS(0) + 1 ' 112090
WHILE RtnCode = 0
RecCt = RecCt + 1 ' 112090
LOCATE ,PrtCol ' 112090
PRINT RecCt ; ' 112090
FileName$ = SPACE$(12)
CALL GetNameF (FileName$,FLen)
FileName$ = LEFT$(FileName$,FLen)
GOSUB AddFileName
CALL FindNextF (RtnCode)
WEND
PRINT
RETURN
ProcessFile:
ON ERROR GOTO 40200 ' 111990
IF SHARING THEN
OPEN InFile$ FOR INPUT SHARED AS #1
ELSE
OPEN InFile$ FOR INPUT AS #1
END IF
ON ERROR GOTO 0 ' 111990
RecCt = 0 ' 112090
PrtCol = POS(0) + 1 ' 112090
WHILE NOT EOF(1)
LINE INPUT #1, A$
RecCt = RecCt + 1 ' 112090
LOCATE ,PrtCol ' 112090
PRINT RecCt ; ' 112090
X$ = UCASE$(A$)
X = INSTR(X$, DirString$) ' 0216
IF X > 0 THEN ' 0224
IF LEFT$(X$,X-1) = SPACE$(X-1) THEN ' 0224
DrivePath$ = MID$(A$, X + LEN(DirString$)) ' 0216
CALL TRIM(DrivePath$)
IF LEFT$(DrivePath$,3) <> "M! " THEN ' 0217
IF INSTR(DrivePath$,"*") > 0 OR INSTR(DrivePath$,"?") > 0 THEN ' 0216
CALL BRKFNAME (DrivePath$,RtnDrivePath$,RtnPrefix$,RtnExt$,TRUE) ' 0216
DrivePath$ = RtnDrivePath$ ' 0216
END IF
IF INSTR(DrivePath$, "\") > 0 THEN
IF RIGHT$(DrivePath$, 1) <> "\" THEN
DrivePath$ = DrivePath$ + "\"
END IF
END IF
END IF ' 0217
CurrentDrivePath$ = DrivePath$
GOSUB SetLocIndex
GOTO DoneEntry
END IF ' 0224
END IF
IF INSTR(" .", LEFT$(A$, 1)) > 0 THEN
GOTO DoneEntry
END IF
IF LEN(A$) < StartCol THEN ' 0224
GOTO DoneEntry ' 0224
END IF ' 0224
IF StartCol > 1 THEN ' 0224
A$ = MID$(A$,StartCol) ' 0224
END IF ' 0224
X = INSTR(A$, " ")
IF X = 0 THEN ' 0217
X = LEN(A$) + 1 ' 0217
ELSE
IF X < 13 THEN
FileName$ = LEFT$(A$, 12)
IF INSTR(FileName$, ".") = 0 AND MID$(FileName$, 9, 1) = " " AND MID$(FileName$, 10, 1) <> " " THEN
MID$(FileName$, X) = "." + MID$(FileName$, 10) + SPACE$(9 - X)
ELSE
FileName$ = LEFT$(A$, X - 1)
END IF
GOSUB AddFileName
GOTO DoneEntry
END IF
END IF ' 0217
FileName$ = LEFT$(A$, X - 1)
CALL BRKFNAME (FileName$,RtnDrivePath$,RtnPrefix$,RtnExt$,TRUE) ' 0217
IF RtnDrivePath$ <> "" THEN ' 0217
DrivePath$ = RtnDrivePath$ ' 0217
FileName$ = RtnPrefix$ + RtnExt$ ' 0217
END IF ' 0217
GOSUB AddFileName
DoneEntry:
WEND
QuitEntry: ' 111990
ON ERROR GOTO 0 ' 111990
CLOSE 1
PRINT ' 111990
RETURN
SetPathName:
CALL BRKFNAME(FileName$, FileDrivePath$, FilePrefix$, FileExt$, TRUE)
IF FileDrivePath$ <> "" THEN
CurrentDrivePath$ = FileDrivePath$
GOSUB SetLocIndex
FileName$ = FilePrefix$ + FileExt$
ELSE
CurrentDrivePath$ = DrivePath$
END IF
RETURN
AddFileName:
GOSUB SetPathName
MID$(NameRec$, 1, 16) = SPACE$(16)
MID$(NameRec$, 1, 12) = FileName$
X$ = MID$(STR$(Location), 2)
X$ = SPACE$(4 - LEN(X$)) + X$
MID$(NameRec$, 13, 4) = X$
NumRecsNameFile = NumRecsNameFile + 1
PUT 2, NumRecsNameFile
RETURN
SetLocIndex:
IF CurrentDrivePath$ = LocationIndex$(Location) THEN RETURN
LocationIndex$(NumRecsLocationFile + 1) = CurrentDrivePath$
Location = 1
WHILE CurrentDrivePath$ <> LocationIndex$(Location)
Location = Location + 1
WEND
IF Location > NumRecsLocationFile THEN
NumRecsLocationFile = Location
MID$(LocationRec$, 1, 63) = SPACE$(63)
MID$(LocationRec$, 1, 63) = CurrentDrivePath$
PUT 3, NumRecsLocationFile
END IF
RETURN
40000 PRINT "Missing configuration file "; ConfigFile$
END
40100 RESUME NEXT
40200 PRINT:PRINT " ";InFile$;" not found. Skipping"; ' 111990
RESUME QuitEntry ' 111990
SUB BRKFNAME (FileName$, DRVPATH$, PREFIX$, EXTENSION$, FOR.JOINING) STATIC
FileName$ = UCASE$(FileName$)
DRVPATH$ = ""
PREFIX$ = ""
EXTENSION$ = ""
CALL TRIMTRAIL(FileName$, "\")
L = LEN(FileName$)
IF L < 1 THEN EXIT SUB
CALL FINDLAST(FileName$, "\", X, Y)
IF X < 1 THEN
IF MID$(FileName$, 2, 1) = ":" THEN
DRVPATH$ = LEFT$(FileName$, 1)
S = 3
ELSE
S = 1
END IF
ELSE
DRVPATH$ = LEFT$(FileName$, X - 1)
S = X + 1
IF Y = 1 THEN
DRVPATH$ = DRVPATH$ + "\"
END IF
END IF
X = INSTR(FileName$ + ".", ".")
IF X < L THEN
EXTENSION$ = MID$(FileName$, X + 1, 3)
END IF
IF S <= L THEN
IF X >= S THEN
PREFIX$ = MID$(FileName$, S, X - S)
END IF
END IF
IF NOT FOR.JOINING THEN EXIT SUB
IF LEN(DRVPATH$) = 1 THEN
IF DRVPATH$ <> "\" THEN
DRVPATH$ = DRVPATH$ + ":"
END IF
END IF
IF INSTR(DRVPATH$, "\") > 0 AND RIGHT$(DRVPATH$, 1) <> "\" THEN DRVPATH$ = DRVPATH$ + "\"
IF LEN(EXTENSION$) > 0 THEN EXTENSION$ = "." + EXTENSION$
END SUB
SUB FINDLAST (LOOK.IN$, LOOK.FOR$, WHERE.FOUND, NUM.FINDS) STATIC
WHERE.FOUND = INSTR(LOOK.IN$, LOOK.FOR$)
NUM.FINDS = -(WHERE.FOUND > 0)
NEXT.FOUND = INSTR(WHERE.FOUND + 1, LOOK.IN$, LOOK.FOR$)
WHILE NEXT.FOUND > 0
NUM.FINDS = NUM.FINDS + 1
WHERE.FOUND = NEXT.FOUND
NEXT.FOUND = INSTR(WHERE.FOUND + 1, LOOK.IN$, LOOK.FOR$)
WEND
END SUB
SUB TRIM (TRIM.PARM$) STATIC
L = INSTR(TRIM.PARM$, " ")
IF L < 1 THEN EXIT SUB
IF L = 1 THEN
WHILE LEFT$(TRIM.PARM$, 1) = " "
TRIM.PARM$ = RIGHT$(TRIM.PARM$, LEN(TRIM.PARM$) - 1)
WEND
END IF
CALL TRIMTRAIL(TRIM.PARM$, " ")
END SUB
SUB TRIMTRAIL (TRIM.PARM$, TRIM.THIS$) STATIC
IF RIGHT$(TRIM.PARM$, 1) <> TRIM.THIS$ THEN EXIT SUB
J = LEN(TRIM.PARM$) - 1
108 IF J > 0 THEN
IF MID$(TRIM.PARM$, J, 1) = TRIM.THIS$ THEN
J = J - 1
GOTO 108
END IF
END IF
TRIM.PARM$ = LEFT$(TRIM.PARM$, J)
END SUB